home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / datamake / main.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  10KB  |  314 lines
  1. unit Main;
  2. { -----------------------  DataMake program --------------------------
  3.   --  (c) 1995 E.Martin.
  4.   --                Compuserve: 100661,3653
  5.   --
  6.   --    This program is a simple code generator. It's intended to produce
  7.   --    a Unit that will create all the databases used by your application.
  8.   --    This way, a program can be shipped without the datafiles, which can
  9.   --    be created as needed.
  10.   --    The program is fairly easy to use, as it is based in the DataList
  11.   --    example program that ships with Delphi.
  12.   --    The code generated : CreateDB.Pas is ready to be included in our project
  13.   --      whenever you decide you can call CreateDBMS to recreate the datafiles.
  14.   --      The code style is structured and readable (as much as this is) and can
  15.   --      be easily modified to further specialize.
  16.   --
  17.   --    This program is FreeWare: use or modify at your own will.
  18.   --
  19.   --  Revision history:
  20.   --  14/Jun/95 : created.
  21.   --
  22.   -----------------------------------------------------------------------
  23. }
  24.  
  25.  
  26. interface
  27.  
  28. uses SysUtils,WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  29.   StdCtrls, DBTables, DB, Buttons, ExtCtrls;
  30.  
  31. type
  32.   TForm1 = class(TForm)
  33.     DatabaseListbox: TListBox;
  34.     TableListbox: TListBox;
  35.     FieldListbox: TListBox;
  36.     IndexListbox: TListBox;
  37.     Label1: TLabel;
  38.     Label2: TLabel;
  39.     Label3: TLabel;
  40.     Label4: TLabel;
  41.     Table: TTable;
  42.     SpeedButton1: TSpeedButton;
  43.     SelectionsListBox: TListBox;
  44.     Label5: TLabel;
  45.     Panel1: TPanel;
  46.     Label6: TLabel;
  47.     procedure AddTable( table: string);
  48.     procedure TableListboxClick(Sender: TObject);
  49.     procedure DatabaseListboxClick(Sender: TObject);
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure TableListboxDblClick(Sender: TObject);
  52.     procedure SpeedButton1Click(Sender: TObject);
  53.     procedure SelectionsListBoxDblClick(Sender: TObject);
  54.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  55.     procedure DatabaseListboxDblClick(Sender: TObject);
  56.   end;
  57.  
  58. var
  59.   Form1: TForm1;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. var
  66.   AliasList: TStringList;
  67.  
  68. procedure TForm1.TableListboxClick(Sender: TObject);
  69. begin
  70.   FieldListbox.Clear;
  71.   IndexListbox.Clear;
  72.   Table.DatabaseName := DatabaseListbox.Items[DatabaseListbox.ItemIndex];
  73.   Table.TableName := TableListbox.Items[TableListbox.ItemIndex];
  74.   Table.GetFieldNames(FieldListbox.Items);
  75.   Table.GetIndexNames(IndexListbox.Items);
  76. end;
  77.  
  78. procedure TForm1.DatabaseListboxClick(Sender: TObject);
  79. begin
  80.   TableListbox.Clear;
  81.   FieldListbox.Clear;
  82.   IndexListbox.Clear;
  83.   Session.GetTableNames(DatabaseListbox.Items[DatabaseListbox.ItemIndex],
  84.     '', True, False, TableListbox.Items);
  85. end;
  86.  
  87. procedure TForm1.FormCreate(Sender: TObject);
  88. begin
  89.   Session.GetDatabaseNames(DatabaseListbox.Items);
  90.   AliasList := TStringList.Create;
  91. end;
  92.  
  93. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  94. begin
  95.   AliasList.Free;
  96. end;
  97.  
  98. procedure TForm1.AddTable( table: string);
  99. var
  100.   idx: Integer;
  101. begin
  102.   { Add to the SelectedList if not already there }
  103.   for idx:= 0 to SelectionsListBox.Items.Count-1 do
  104.     if SelectionsListBox.Items[idx] = table
  105.        then Exit;
  106.   SelectionsListBox.Items.Add(table);
  107.   AliasList.Add(DatabaseListbox.Items[DatabaseListbox.ItemIndex]);
  108. end;
  109.  
  110. procedure TForm1.DatabaseListboxDblClick(Sender: TObject);
  111. var
  112.   idx: Integer;
  113. begin
  114.   { Add all the DataBase tables to the selection list }
  115.   {SelectionsListBox.Items.AddStrings(TableListbox.Items);}
  116.   for idx:= 0 to TableListBox.Items.Count-1 do
  117.      AddTable(TableListBox.Items[idx]);
  118. end;
  119.  
  120.  
  121. procedure TForm1.TableListboxDblClick(Sender: TObject);
  122. begin
  123.   AddTable(TableListbox.Items[TableListbox.ItemIndex]);
  124. end;
  125.  
  126. procedure TForm1.SelectionsListBoxDblClick(Sender: TObject);
  127. begin
  128.   { remove elem from table }
  129.   SelectionsListBox.Items.Delete(SelectionsListBox.ItemIndex);
  130. end;
  131.  
  132. function GetTableType(table : tTable):string;
  133. begin
  134.   if Table.tableType = ttDefault then
  135.   begin
  136.     if CompareText(ExtractFileExt(Table.TableName), '.dbf') = 0 then
  137.     begin
  138.       GetTableType := 'ttDBase';
  139.       exit;
  140.     end
  141.     else if CompareText(ExtractFileExt(Table.TableName), '.db') = 0 then
  142.     begin
  143.       GetTableType := 'ttParadox';
  144.       exit;
  145.     end
  146.     else GetTableType := 'ttDefault';
  147.   end
  148.   else if table.tableType = ttDBase then GetTableType := 'ttDBase'
  149.   else if Table.TableType = ttParadox then GetTableType := 'ttParadox'
  150.   else GetTableType := 'ttASCII';
  151. end;
  152.  
  153. function GetFieldType(fldtyp:TFieldType) : string;
  154. begin
  155.   case fldtyp of
  156.     ftUnknown : Result := 'ftUnknown';
  157.     ftString :  Result := 'ftString';
  158.     ftSmallInt: Result := 'ftSmallInt';
  159.     ftInteger : Result := 'ftInteger';
  160.     ftWord :    Result := 'ftWord';
  161.     ftBoolean:  Result := 'ftBoolean';
  162.     ftFloat :   Result := 'ftFloat';
  163.     ftCurrency: Result := 'ftCurrency';
  164.     ftBCD :     Result := 'ftBCD';
  165.     ftDate :    Result := 'ftDate';
  166.     ftTime :    Result := 'ftTime';
  167.     ftDateTime: Result := 'ftDateTime';
  168.     ftBytes :   Result := 'ftBytes';
  169.     ftVarBytes: Result := 'ftVarBytes';
  170.     ftBlob :    Result := 'ftBlob';
  171.     ftMemo :    Result := 'ftMemo';
  172.     ftGraphic : Result := 'ftGraphic';
  173.   end;
  174. end;
  175.  
  176. function GetRequired(required:Boolean): string;
  177. begin
  178.   if required then Result := 'True'
  179.     else           Result := 'False';
  180. end;
  181.  
  182. function GetIndexOptions(Options: TIndexOptions): string;
  183. begin
  184.   Result := '[';
  185.   if ixPrimary in Options then Result := Result +'ixPrimary';
  186.   if ixUnique in Options then
  187.   begin
  188.      if Length(Result) > 1 then Result := Result +', ';
  189.      Result := Result +'ixUnique';
  190.   end;
  191.   if ixDescending in Options then
  192.   begin
  193.      if Length(Result) > 1 then Result := Result +', ';
  194.      Result := Result +'ixDescending';
  195.   end;
  196.   if ixExpression in Options then
  197.   begin
  198.      if Length(Result) > 1 then Result := Result +', ';
  199.      Result := Result +'ixExpression';
  200.   end;
  201.   if ixCaseInsensitive in Options then
  202.   begin
  203.      if Length(Result) > 1 then Result := Result +', ';
  204.      Result := Result +'ixCaseInsensitive';
  205.   end;
  206.   Result := Result+']';
  207. end;
  208.  
  209.  
  210. { ----------------
  211.   Code generation
  212.   ---------------- }
  213. procedure TForm1.SpeedButton1Click(Sender: TObject);
  214. var
  215.    idx, jdx: Integer;
  216.    nl, qt, sTemp: string;
  217.    out: TextFile;
  218. begin
  219.   if SelectionsListBox.Items.Count = 0 then
  220.   begin
  221.     Close;
  222.     Exit;
  223.   end;
  224.   SetCursor(LoadCursor(0,IDC_WAIT));
  225.  
  226.   { 1- Open output file : CreateDB.pas }
  227.   AssignFile(out, 'CreateDB.PAS');
  228.   Rewrite(out);
  229.  
  230.   { 2- Generate common code header }
  231.   nl := #13+#10; { newline }
  232.   qt := #39;     { quote }
  233.   Write(out, 'Unit CreateDB;'+nl+
  234.              '{ Generated by DataMake (c) 1995 E. Martin'+nl+
  235.              '      Date : '+DateToStr(Now)+' }'+nl+nl+
  236.              'interface'+nl+nl+
  237.              'procedure CreateDBMS;'+nl+nl+
  238.              'implementation'+nl+nl+
  239.              'uses DBTables, DB;'+nl+nl);
  240.              { breaking block to prevent overflowing output buffer }
  241.   Write(out, 'procedure CreateDBMS;'+nl+
  242.              'var'+nl+
  243.              '  table: TTable;'+nl+
  244.              'begin'+nl+
  245.              '  table := TTable.Create(nil);'+nl+
  246.              '  with table do'+nl+
  247.              '  begin'+
  248.              nl);
  249.  
  250.   { 3- For each table in the Selection box }
  251.   for idx:= 0 to SelectionsListBox.Items.Count-1 do
  252.   begin
  253.  
  254.     { 4- Generate table structure }
  255.     with Table do
  256.     begin
  257.       DatabaseName := AliasList[idx];
  258.       TableName := SelectionsListBox.Items[idx];
  259.       FieldDefs.Update;
  260.       IndexDefs.Update;
  261.       { now we have the table on-line }
  262.       Write(out, nl+'    { Creating : '+DatabaseName+' --> '+TableName+' }'+nl+
  263.                  '    DataBaseName := '+qt+ DatabaseName +qt+';'+nl+
  264.                  '    TableName := '+qt+ TableName +qt+';'+nl+
  265.                  '    TableType := '+GetTableType(Table)+';'+nl+
  266.                  '    with FieldDefs do'+nl+
  267.                  '    begin'+nl+
  268.                  '      Clear;'+
  269.                  nl);
  270.       with FieldDefs do
  271.       begin
  272.         for jdx:=0 to Count-1 do
  273.         begin
  274.           Write(out, '      Add('+qt+Items[jdx].Name+qt+', '+
  275.                      GetFieldType(Items[jdx].DataType)+', '+
  276.                      IntToStr(Items[jdx].Size)+', '+
  277.                      GetRequired(Items[jdx].Required)+');'+nl);
  278.         end;
  279.       end; { FieldDefs }
  280.       Write(out, '    end; { FieldDefs }'+nl);
  281.  
  282.       { 5- Generate index structure }
  283.       Write(out, '    with IndexDefs do'+nl+
  284.                  '    begin'+nl+
  285.                  '      Clear;'+nl);
  286.       with IndexDefs do
  287.       begin
  288.         for jdx:=0 to Count-1 do
  289.         begin
  290.           Write(out, '      Add('+qt+Items[jdx].Name+qt+', '+
  291.                      qt+Items[jdx].Fields+qt+', '+
  292.                      GetIndexOptions(Items[jdx].Options)+');'+nl);
  293.           if ixExpression in TIndexDef(Items[jdx]).Options  then { this would require some hardcore DBE programming }
  294.             raise Exception.Create('SORRY: This version of DataMake doesnt support dBase Index Expressions');
  295.         end;
  296.       end; { IndexDefs }
  297.       Write(out, '    end; { IndexDefs }'+nl);
  298.     end; {table}
  299.     Write(out, '    CreateTable;'+nl);
  300.   end;
  301.  
  302.   { 6- Generate common code footer }
  303.   Write(out,'  end; { table }'+nl+
  304.             '  table.Free;'+nl+
  305.             'end;'+nl+nl+
  306.             'end.'+nl);
  307.  
  308.   CloseFile(out);
  309.   SetCursor(LoadCursor(0,IDC_ARROW));
  310.   Close;
  311. end;
  312.  
  313. end.
  314.